home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / cutbuffer.tcl.z / cutbuffer.tcl
Text File  |  2002-07-08  |  1KB  |  51 lines
  1. # cutbuffer.tcl
  2. #    Stub for missing cutbuffer command
  3. #    The best thing to do is add the tkCutbuffer.c code to your wish.
  4. #    However, if that is not done, then these stub routines mask
  5. #    the missing functionality
  6.  
  7. proc cutbuffer {args} {
  8.     global cut_priv
  9.     if ![info exists cut_priv(init)] {
  10.     set cut_priv(init) 1
  11.     Exmh_Debug "cutbuffer command missing (add tkCutbuffer.c to wish)"
  12.     }
  13.     set op [lindex $args 0]
  14.     set ix [lindex $args 1]
  15.     switch -- $op {
  16.     set {
  17.         set cut_priv($ix) [lindex $args 2]
  18.     }
  19.     get {
  20.         if ![info exists cut_priv($ix)] {
  21.         error "cutbuffer $ix undefined"
  22.         } else {
  23.         return $cut_priv($ix)
  24.         }
  25.     }
  26.     rotate {
  27.         if {$ix < 0} {
  28.         # Popping
  29.         for {set ix 0} {$ix < 7} {incr ix} {
  30.             set next [expr $ix+1]
  31.             if ![info exists cut_priv($next)] {
  32.             set cut_priv($ix) {}
  33.             } else {
  34.             set cut_priv($ix) $cut_priv($next)
  35.             }
  36.         }
  37.         } else {
  38.         for {set ix 7} {$ix > 0} {incr ix -1} {
  39.             set prev [expr $ix-1]
  40.             if ![info exists cut_priv($prev)] {
  41.             set cut_priv($ix) {}
  42.             } else {
  43.             set cut_priv($ix) $cut_priv($prev)
  44.             }
  45.         }
  46.         }
  47.     }
  48.     }
  49.     return {}
  50. }
  51.